home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD339.psc / Program Basic / HChess / frmChess.frm (.txt)
Encoding:
Visual Basic Form  |  1999-08-11  |  24.0 KB  |  725 lines
  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
  3. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  4. Object = "{5336AD54-C994-11D2-B7D6-444553540000}#11.0#0"; "HCHESSBOARDP.OCX"
  5. Begin VB.Form frmChess 
  6.    AutoRedraw      =   -1  'True
  7.    BackColor       =   &H00FFFFFF&
  8.    BorderStyle     =   1  'Fixed Single
  9.    Caption         =   "Chess Board"
  10.    ClientHeight    =   7095
  11.    ClientLeft      =   45
  12.    ClientTop       =   375
  13.    ClientWidth     =   6975
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   473
  18.    ScaleMode       =   3  'Pixel
  19.    ScaleWidth      =   465
  20.    Begin VB.Timer Timer4 
  21.       Left            =   7440
  22.       Top             =   6360
  23.    End
  24.    Begin VB.Timer Timer3 
  25.       Left            =   7440
  26.       Top             =   5880
  27.    End
  28.    Begin VB.Timer Timer2 
  29.       Left            =   7440
  30.       Top             =   5400
  31.    End
  32.    Begin VB.Timer Timer1 
  33.       Left            =   7440
  34.       Top             =   4920
  35.    End
  36.    Begin MSWinsockLib.Winsock SockClient 
  37.       Left            =   7440
  38.       Top             =   4440
  39.       _ExtentX        =   741
  40.       _ExtentY        =   741
  41.       _Version        =   393216
  42.    End
  43.    Begin PicClip.PictureClip PictureClip1 
  44.       Left            =   7320
  45.       Top             =   3960
  46.       _ExtentX        =   6985
  47.       _ExtentY        =   556
  48.       _Version        =   393216
  49.       Picture         =   "frmChess.frx":0000
  50.    End
  51.    Begin VB.PictureBox Picture1 
  52.       Appearance      =   0  'Flat
  53.       AutoSize        =   -1  'True
  54.       BackColor       =   &H80000005&
  55.       BorderStyle     =   0  'None
  56.       ForeColor       =   &H80000008&
  57.       Height          =   525
  58.       Left            =   315
  59.       Picture         =   "frmChess.frx":414A
  60.       ScaleHeight     =   525
  61.       ScaleWidth      =   6330
  62.       TabIndex        =   9
  63.       Top             =   480
  64.       Width           =   6330
  65.       Begin VB.Image Image1 
  66.          Height          =   255
  67.          Index           =   5
  68.          Left            =   5880
  69.          ToolTipText     =   "Help"
  70.          Top             =   120
  71.          Width           =   375
  72.       End
  73.       Begin VB.Image Image1 
  74.          Height          =   255
  75.          Index           =   4
  76.          Left            =   5160
  77.          ToolTipText     =   "Chat Window"
  78.          Top             =   120
  79.          Width           =   375
  80.       End
  81.       Begin VB.Image Image1 
  82.          Height          =   255
  83.          Index           =   3
  84.          Left            =   4680
  85.          ToolTipText     =   "Info Game Window"
  86.          Top             =   120
  87.          Width           =   375
  88.       End
  89.       Begin VB.Image Image1 
  90.          Height          =   255
  91.          Index           =   2
  92.          Left            =   3960
  93.          ToolTipText     =   "Music"
  94.          Top             =   120
  95.          Width           =   375
  96.       End
  97.       Begin VB.Image Image1 
  98.          Height          =   255
  99.          Index           =   1
  100.          Left            =   3480
  101.          ToolTipText     =   "No Sound"
  102.          Top             =   120
  103.          Width           =   375
  104.       End
  105.       Begin VB.Image Image1 
  106.          Height          =   255
  107.          Index           =   0
  108.          Left            =   120
  109.          ToolTipText     =   "New Game"
  110.          Top             =   120
  111.          Width           =   375
  112.       End
  113.    End
  114.    Begin HChessBoardP.HChessBoard HChessBoard1 
  115.       Height          =   6360
  116.       Left            =   300
  117.       TabIndex        =   11
  118.       Top             =   480
  119.       Width           =   6360
  120.       _ExtentX        =   11218
  121.       _ExtentY        =   11218
  122.       DiffBoard_Y     =   11
  123.       DiffBoard_X     =   11
  124.       BoardWidth      =   424
  125.       BoardHeight     =   424
  126.    End
  127.    Begin VB.Image Image2 
  128.       Height          =   240
  129.       Left            =   7320
  130.       Picture         =   "frmChess.frx":4E6A
  131.       Top             =   3480
  132.       Visible         =   0   'False
  133.       Width           =   240
  134.    End
  135.    Begin VB.Label Label3 
  136.       BackStyle       =   0  'Transparent
  137.       Caption         =   "Guest Vs Opponent"
  138.       BeginProperty Font 
  139.          Name            =   "Lucida Sans"
  140.          Size            =   14.25
  141.          Charset         =   0
  142.          Weight          =   700
  143.          Underline       =   0   'False
  144.          Italic          =   -1  'True
  145.          Strikethrough   =   0   'False
  146.       EndProperty
  147.       ForeColor       =   &H80000002&
  148.       Height          =   330
  149.       Left            =   600
  150.       TabIndex        =   10
  151.       Top             =   75
  152.       Width           =   5295
  153.    End
  154.    Begin VB.Label Label2 
  155.       BackStyle       =   0  'Transparent
  156.       Caption         =   "1"
  157.       BeginProperty Font 
  158.          Name            =   "MS Sans Serif"
  159.          Size            =   8.25
  160.          Charset         =   0
  161.          Weight          =   700
  162.          Underline       =   0   'False
  163.          Italic          =   0   'False
  164.          Strikethrough   =   0   'False
  165.       EndProperty
  166.       Height          =   255
  167.       Index           =   7
  168.       Left            =   75
  169.       TabIndex        =   8
  170.       Top             =   6120
  171.       Width           =   135
  172.    End
  173.    Begin VB.Label Label2 
  174.       BackStyle       =   0  'Transparent
  175.       Caption         =   "2"
  176.       BeginProperty Font 
  177.          Name            =   "MS Sans Serif"
  178.          Size            =   8.25
  179.          Charset         =   0
  180.          Weight          =   700
  181.          Underline       =   0   'False
  182.          Italic          =   0   'False
  183.          Strikethrough   =   0   'False
  184.       EndProperty
  185.       Height          =   255
  186.       Index           =   6
  187.       Left            =   75
  188.       TabIndex        =   7
  189.       Top             =   5400
  190.       Width           =   135
  191.    End
  192.    Begin VB.Label Label2 
  193.       BackStyle       =   0  'Transparent
  194.       Caption         =   "3"
  195.       BeginProperty Font 
  196.          Name            =   "MS Sans Serif"
  197.          Size            =   8.25
  198.          Charset         =   0
  199.          Weight          =   700
  200.          Underline       =   0   'False
  201.          Italic          =   0   'False
  202.          Strikethrough   =   0   'False
  203.       EndProperty
  204.       Height          =   255
  205.       Index           =   5
  206.       Left            =   75
  207.       TabIndex        =   6
  208.       Top             =   4680
  209.       Width           =   135
  210.    End
  211.    Begin VB.Label Label2 
  212.       BackStyle       =   0  'Transparent
  213.       Caption         =   "4"
  214.       BeginProperty Font 
  215.          Name            =   "MS Sans Serif"
  216.          Size            =   8.25
  217.          Charset         =   0
  218.          Weight          =   700
  219.          Underline       =   0   'False
  220.          Italic          =   0   'False
  221.          Strikethrough   =   0   'False
  222.       EndProperty
  223.       Height          =   255
  224.       Index           =   4
  225.       Left            =   75
  226.       TabIndex        =   5
  227.       Top             =   3960
  228.       Width           =   135
  229.    End
  230.    Begin VB.Label Label2 
  231.       BackStyle       =   0  'Transparent
  232.       Caption         =   "5"
  233.       BeginProperty Font 
  234.          Name            =   "MS Sans Serif"
  235.          Size            =   8.25
  236.          Charset         =   0
  237.          Weight          =   700
  238.          Underline       =   0   'False
  239.          Italic          =   0   'False
  240.          Strikethrough   =   0   'False
  241.       EndProperty
  242.       Height          =   255
  243.       Index           =   3
  244.       Left            =   75
  245.       TabIndex        =   4
  246.       Top             =   3120
  247.       Width           =   135
  248.    End
  249.    Begin VB.Label Label2 
  250.       BackStyle       =   0  'Transparent
  251.       Caption         =   "6"
  252.       BeginProperty Font 
  253.          Name            =   "MS Sans Serif"
  254.          Size            =   8.25
  255.          Charset         =   0
  256.          Weight          =   700
  257.          Underline       =   0   'False
  258.          Italic          =   0   'False
  259.          Strikethrough   =   0   'False
  260.       EndProperty
  261.       Height          =   255
  262.       Index           =   2
  263.       Left            =   75
  264.       TabIndex        =   3
  265.       Top             =   2400
  266.       Width           =   135
  267.    End
  268.    Begin VB.Label Label2 
  269.       BackStyle       =   0  'Transparent
  270.       Caption         =   "7"
  271.       BeginProperty Font 
  272.          Name            =   "MS Sans Serif"
  273.          Size            =   8.25
  274.          Charset         =   0
  275.          Weight          =   700
  276.          Underline       =   0   'False
  277.          Italic          =   0   'False
  278.          Strikethrough   =   0   'False
  279.       EndProperty
  280.       Height          =   255
  281.       Index           =   1
  282.       Left            =   75
  283.       TabIndex        =   2
  284.       Top             =   1680
  285.       Width           =   135
  286.    End
  287.    Begin VB.Label Label2 
  288.       BackStyle       =   0  'Transparent
  289.       Caption         =   "8"
  290.       BeginProperty Font 
  291.          Name            =   "MS Sans Serif"
  292.          Size            =   8.25
  293.          Charset         =   0
  294.          Weight          =   700
  295.          Underline       =   0   'False
  296.          Italic          =   0   'False
  297.          Strikethrough   =   0   'False
  298.       EndProperty
  299.       Height          =   255
  300.       Index           =   0
  301.       Left            =   75
  302.       TabIndex        =   1
  303.       Top             =   960
  304.       Width           =   135
  305.    End
  306.    Begin VB.Label Label1 
  307.       BackStyle       =   0  'Transparent
  308.       Caption         =   "A            B          C          D          E          F          G           H"
  309.       BeginProperty Font 
  310.          Name            =   "MS Sans Serif"
  311.          Size            =   8.25
  312.          Charset         =   0
  313.          Weight          =   700
  314.          Underline       =   0   'False
  315.          Italic          =   0   'False
  316.          Strikethrough   =   0   'False
  317.       EndProperty
  318.       Height          =   255
  319.       Index           =   0
  320.       Left            =   720
  321.       TabIndex        =   0
  322.       Top             =   6855
  323.       Width           =   5775
  324.    End
  325. Attribute VB_Name = "frmChess"
  326. Attribute VB_GlobalNameSpace = False
  327. Attribute VB_Creatable = False
  328. Attribute VB_PredeclaredId = True
  329. Attribute VB_Exposed = False
  330. Dim HoldIndex
  331. Dim OPTSelected As Boolean
  332. Dim piecejouer As String
  333. Dim hr, min, sec As Integer
  334. Dim hrs, mins, secs As String
  335. Dim tempdebcoup
  336. Dim waitforplayer As Boolean
  337. Dim nbcoupmoi As Long
  338. Dim nbcoup As Long
  339. Dim montour As Boolean
  340. Dim entraitement As Boolean
  341. Dim sendok As Boolean
  342. Public Sub recommendeG()
  343. On Error Resume Next
  344. ChessBoard1.EraseBoard
  345. If PlayOffline Then
  346.    If Connected Then SockClient.SendData "#020code#findepart"
  347. Dim str1
  348.   If JoueurHote Then
  349.    str1 = "false"
  350.   Else
  351.    str1 = "true"
  352.   End If
  353. If Connected Then SockClient.SendData "#020code#recomgame" & str1
  354. End If
  355. 'initpartie
  356. End Sub
  357. Private Sub Form_Initialize()
  358. strArg = Command()
  359. If strArg <> "" Then CheckArg strArg
  360. End Sub
  361. Private Sub Form_Unload(Cancel As Integer)
  362. HChessBoard1.ClearGraphicBuffer
  363. Unload frmchat1
  364. Unload frmInfoG
  365. End Sub
  366. Private Sub HChessBoard1_EventStatus()
  367. 'frmInfoG.Label1.Caption = HChessBoard1.StatusString
  368. End Sub
  369. Private Sub SockClient_ConnectionRequest(ByVal requestID As Long)
  370. On Error Resume Next
  371. Dim rep
  372. rep = MsgBox("You have a Visitor Request, Do You want to Accept ?", vbYesNoCancel, "Connection !")
  373. If rep = vbCancel Or rep = vbNo Then Exit Sub
  374. If SockClient.State <> sckClosed Then
  375.   SockClient.Close
  376. End If
  377.  SockClient.Accept requestID
  378.  SockClient.SendData "#020code#okconnect" & NickName
  379.  Timer3.Interval = 1000
  380.  DoEvents
  381. End Sub
  382. Private Sub SockClient_DataArrival(ByVal bytesTotal As Long)
  383. On Error Resume Next
  384. Dim strdata As String
  385. SockClient.GetData strdata
  386. If Mid(strdata, 1, 9) = "#010text#" Then
  387.   frmchat1.List1.AddItem VisitorName & " Say >> " & Mid(strdata, 10, Len(strdata) - 9)
  388.   frmchat1.List1.ListIndex = frmchat1.List1.ListCount - 1
  389. Dim code1, code2
  390.  code1 = Mid(strdata, 1, 14)
  391.  code2 = Mid(strdata, 1, 18)
  392.  Select Case code1
  393.  Case "#010#code:move": joujeuadv strdata, "move"
  394.  Case "#010#code:rock": joujeuadv strdata, "rock"
  395.  Case "#010#code:quen": joujeuadv strdata, "quen"
  396.  Case "#010#code:ches": joujeuadv strdata, "ches"
  397. End Select
  398. Select Case code2
  399.  Case "#020code#wantnewga": WantaNewGame strdata
  400.  Case "#020code#kfornewga": Unload frmWaitting: nouvelleP strdata
  401.  Case "#020code#okconnect": okconnect strdata
  402.  Case "#020code#receiveok": nouvelleP strdata
  403.  Case "#020code#refunewga": RefuseNewGame
  404.  Case "#020code#quitegame": quitthegame
  405.  'Case "#020code#movepitou": joujeuadv strdata
  406.  End Select
  407. End If
  408. End Sub
  409. Private Sub quitthegame()
  410. MsgBox VisitorName & " Has left the game !"
  411. HChessBoard1.EraseBoard
  412. PartiEnCour = False
  413. End Sub
  414. Private Sub RefuseNewGame()
  415. MsgBox "Your Opponent has refused your proposal !"
  416. Unload frmWaitting
  417. End Sub
  418. Private Sub WantaNewGame(strdata)
  419. Dim rep, strtemp
  420. rep = MsgBox(VisitorName & " have a new proposal do you want to accept ?", vbYesNo, "New Game")
  421. If rep = vbYes Then
  422.  SockClient.SendData "#020code#kfornewga"
  423.  strtemp = Mid(strdata, 19, Len(strdata) - 18)
  424.  If strtemp = "No" Then
  425.   JoueurHote = True
  426.   HChessBoard1.Host = True
  427.  Else
  428.   JoueurHote = False
  429.   HChessBoard1.Host = False
  430.  End If
  431.   HChessBoard1.PlayOffline = False
  432.   PlayOffline = False
  433.   Connected = True
  434.   HChessBoard1.InitGame
  435.  SockClient.SendData "#020code#refunewga"
  436.  HChessBoard1.EraseBoard
  437. End If
  438. End Sub
  439. Private Sub nouvelleP(strdata)
  440. On Error Resume Next
  441. VisitorName = Mid(strdata, 19, Len(strdata) - 18)
  442. 'Label1.Caption = Label1.Caption & " " & Mid(strdata, 19, Len(strdata) - 18)
  443. Connected = True
  444. PartiEnCour = True
  445. Timer3.Interval = 1000
  446. 'List1.Clear
  447. 'If HChessBoard1.CanIPlay Then frmInfoG.Label1.Caption = "Your Turn" Else frmInfoG.Label1.Caption = "Your Turn"
  448. InitGame
  449. End Sub
  450. Private Sub okconnect(strdt)
  451. On Error Resume Next
  452. nouvelleP strdt
  453. SockClient.SendData "#020code#receiveok" & NickName
  454. DoEvents
  455. End Sub
  456. Private Sub findepartie(msg1)
  457. On Error Resume Next
  458. 'Timer5.Interval = 0
  459. 'Timer2.Interval = 0
  460. 'DoEvents
  461. 'Label2.Caption = "Start a New Game !"
  462. 'List2.Clear
  463. 'Command2.Caption = "New Game"
  464. 'ChessBoard1.EraseBoard
  465. 'PartiEnCour = False
  466. 'MsgBox msg1
  467. End Sub
  468. Private Sub joujeuadv(strdat, cod)
  469. On Error Resume Next
  470. Dim strtemp, code
  471. code = Mid(strdat, 1, 14)
  472. Dim p1, p2, p3, p4
  473. p1 = Val(InStr(1, strdat, "-", vbBinaryCompare))
  474. p2 = Val(InStr(p1 + 1, strdat, "-", vbBinaryCompare))
  475. p3 = Val(InStr(p2 + 1, strdat, "-", vbBinaryCompare))
  476. p4 = Val(InStr(p3 + 1, strdat, "-", vbBinaryCompare))
  477. Dim val1, val2, val3, val4
  478. val1 = Val(Mid(strdat, 15, p1 - 15)): val2 = Val(Mid(strdat, p1 + 1, p2 - 15)): val3 = Val(Mid(strdat, p2 + 1, p3 - 15)): val4 = Val(Mid(strdat, p3 + 1, Len(strdat) - 2 - (p2))) 'lit la position du move
  479. val1 = 7 - val1: val2 = 7 - val2: val3 = 7 - val3: val4 = 7 - val4
  480. strtemp = Str(val1) & Chr(val2 + 65) & " To " & Str(val3) & Chr(val4 + 65)
  481. 'List2.List(List2.ListCount - 1) = "I: " & (nbcoup - nbcoupmoi) & " - " & nomoposant & " -T- : " & hrs & ":" & mins & ":" & secs & " -M- : " & strtemp
  482. nbcoup = nbcoup + 1
  483. nbcoupmoi = nbcoupmoi + 1
  484. hrs = "": mins = "": secs = ""
  485. hr = 0: min = 0: sec = 0
  486. 'List2.AddItem "I: " & nbcoupmoi & " - " & NickName & " -T- : " & hrs & ":" & mins & ":" & secs
  487. 'List2.ListIndex = List2.ListCount - 1
  488. HChessBoard1.MoveThePlayer2Piece val1, val2, val3, val4, cod
  489. DoEvents
  490. waitforplayer = False
  491. End Sub
  492. Private Sub Timer2_Timer()
  493. On Error Resume Next
  494. If min = 59 Then min = 0: hr = hr + 1: hrs = trans(hr): mins = trans(min)
  495. If sec = 59 Then sec = 0: min = min + 1: mins = trans(min)
  496. sec = sec + 1
  497. secs = trans(sec)
  498. 'If Not waitforplayer Then
  499.  ' frmInfoG.List1.List(List2.ListCount - 1) = "I: " & nbcoupmoi & " - " & NickName & " -T- : " & hrs & ":" & mins & ":" & secs
  500. 'Else
  501. '  frmInfoG.List1.List(List2.ListCount - 1) = "I: " & (nbcoup - nbcoupmoi) & " - " & nomoposant & " -T- : " & hrs & ":" & mins & ":" & secs
  502. 'End If
  503. End Sub
  504. Private Sub Timer3_Timer()
  505. checkdisconnect
  506. End Sub
  507. Private Sub checkdisconnect()
  508. On Error Resume Next
  509. If SockClient.State <> 7 And Connected Then
  510.   SockClient.Close
  511.   MsgBox "You are Disconnected !"
  512.   PartiEnCour = False
  513.   Unload frmWaitting
  514.   Timer2.Interval = 0
  515.   Timer3.Interval = 0
  516.   Connected = False
  517.   HChessBoard1.EraseBoard
  518.   PartiEnCour = False
  519.   'frmInfoG.Label1.Caption = "Start a New Game !"
  520.   'frmInfoG.List1.Clear: List2.Clear
  521. End If
  522. End Sub
  523. Private Function trans(var1) As String
  524. On Error Resume Next
  525. If var1 = 0 Then
  526.  trans = "00"
  527. If var1 < 10 Then
  528.   trans = "0" & Trim(Str(var1))
  529.   trans = Trim(Str(var1))
  530. End If
  531. End If
  532. End Function
  533. Public Sub InitGame()
  534. On Error Resume Next
  535. hrs = "": mins = "": secs = ""
  536. hr = 0: min = 0: sec = 0
  537. nbcoup = 1:
  538. If PlayOffline Then
  539.   HChessBoard1.PlayOffline = True
  540.   HChessBoard1.Host = True
  541.   Command2.Caption = "New Game"
  542.   'frmInfoG.Label1.Caption = "Offline game !"
  543.   HChessBoard1.PlayOffline = False
  544.   If JoueurHote Then
  545.     nbcoupmoi = 1
  546.     waitforplayer = False
  547.     HChessBoard1.Host = True
  548.    ' frmInfoG.Label1.Caption = "Your Turn !"
  549.   Else
  550.     nbcoupmoi = 0
  551.     HChessBoard1.Host = False
  552.     waitforplayer = True
  553.     'frmInfoG.Label1.Caption = "Wait Your Turn !"
  554.   End If
  555.   Timer2.Interval = 1000
  556.  End If
  557. Label3.Caption = Label3.Caption & VisitorName
  558. HChessBoard1.Sound = True
  559. HChessBoard1.MoveString = ""
  560. HChessBoard1.CreateGraphicBuffer
  561. HChessBoard1.InitGame
  562. 'frmInfoG.List1.Clear
  563. PartiEnCour = True
  564. End Sub
  565. Private Sub Form_Load()
  566. 'On Error Resume Next
  567. Dim strArg As String
  568. OutSquare 0, 0, ScaleWidth - 1, ScaleHeight, Me
  569. InSquare HChessBoard1.Left, HChessBoard1.Top, HChessBoard1.Width - 1, HChessBoard1.Height, Me
  570. PaintPicture Image2.Picture, 15, 5
  571. PaintPicture Image2.Picture, ScaleWidth - 35, 5
  572. JoueurHote = True
  573. HostName = "Computer Name/IP"
  574. NickName = "Guest"
  575. VisitorName = "Opponent"
  576. SockClient.Protocol = sckTCPProtocol
  577. SockClient.RemoteHost = "pc2"
  578. SockClient.RemotePort = 1004
  579. SockClient.LocalPort = 1004
  580. HoldIndex = -1
  581. currentdirectory = CurDir("")
  582. PictureClip1.Cols = 12
  583. For i = 0 To 5
  584.  Image1(i).Picture = PictureClip1.GraphicCell(i)
  585.  Next i
  586. If fromServer Then currentdirectory = currentdirectory & "\VChess"
  587. 'frmChat1.Show
  588. 'frmChat1.Left = 500
  589. HChessBoard1.PickUpSoundFile = currentdirectory & "\Sounds\PickUp.wav"
  590. HChessBoard1.PutDownSoundFile = currentdirectory & "\Sounds\WoodThunk.wav"
  591. HChessBoard1.StartGameSoundFile = currentdirectory & "\Sounds\Opening.wav"
  592. HChessBoard1.ChessSoundFile = "c:\windows\Media\canyon.mid" 'currentdirectory & "\Sounds\Rockem.mid"
  593. HChessBoard1.MoveNotAllowedSoundFile = currentdirectory & "\Sounds\Orchestra.wav"
  594. Set HChessBoard1.PiecePicture = LoadPicture(currentdirectory & "\Images\PieceBR.bmp")
  595. Set HChessBoard1.BoardPicture = LoadPicture(currentdirectory & "\Images\BlueMarbBoard.bmp")
  596. 'HChessBoard1.PickUpSoundFile = "e:\Program Basic\HChessGameProj\Sounds\PickUp.wav"
  597. 'HChessBoard1.PutDownSoundFile = "e:\Program Basic\HChessGameProj\Sounds\WoodThunk.wav"
  598. 'HChessBoard1.StartGameSoundFile = "e:\Program Basic\HChessGameProj\Sounds\Opening.wav"
  599. 'HChessBoard1.ChessSoundFile = "e:\Program Basic\HChessGameProj\Sounds\Orchestra.wav"
  600. 'HChessBoard1.MoveNotAllowedSoundFile = "e:\Program Basic\HChessGameProj\Sounds\Orchestra.wav"
  601. 'Set HChessBoard1.PiecePicture = LoadPicture("e:\Program Basic\HChessGameProj\Images\PieceBR.bmp")
  602. 'Set HChessBoard1.BoardPicture = LoadPicture("e:\Program Basic\HChessGameProj\Images\BlueMarbBoard.bmp")
  603. DoEvents
  604. End Sub
  605. Private Sub CheckArg(strdata)
  606. fromServer = True
  607. Me.Visible = True
  608. Dim pos, pos2, nick, myname, hisname, caseT, hisIP
  609. pos = InStr(10, Trim(strdata), "|", vbBinaryCompare)
  610. myname = Mid(Trim(strdata), 10, pos - 10)
  611. pos2 = InStr(pos + 1, Trim(strdata), "|", vbBinaryCompare)
  612. hisname = Mid(Trim(strdata), pos + 1, pos2 - pos1)
  613. VisitorName = hisname
  614. VisitorName = myname
  615. HChessBoard1.PlayOffline = False
  616. PlayOffline = False
  617. caseT = Mid(strdata, 1, 9)
  618. If caseT = "|HostUsr|" Then
  619.   HChessBoard1.Host = True
  620.   JoueurHote = True
  621.   frmChess.SockClient.Close
  622.   frmChess.SockClient.Protocol = sckTCPProtocol
  623.   frmChess.SockClient.LocalPort = 1004
  624.   frmChess.SockClient.Listen
  625.   'frmInfoG.Label1.Caption = "Wait For Other Player"
  626.   waitforplayer = True
  627.   frmtryConnect.GetinitWaitting
  628.   DoEvents
  629.   frmtryConnect.Show 1
  630. ElseIf caseT = "|HostTsr|" Then
  631.   hisIP = Mid(Trim(strdata), pos2 + 1, Len(strdata))
  632.   HChessBoard1.Host = False
  633.   JoueurHote = False
  634.   HostName = hisIP
  635.   SockClient.RemotePort = 1004
  636.   SockClient.RemoteHost = HostName
  637.   'frmInfoG.Label1.Caption = "Try to Connect"
  638.   NameNIP.Connect
  639.   DoEvents
  640.   frmtryConnect.GetinitWaitting
  641.   DoEvents
  642.   frmtryConnect.Show 1
  643. End If
  644. 'MsgBox ArgStr
  645. End Sub
  646. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  647. Picture1.Visible = Not Picture1.Visible
  648. End Sub
  649. Private Sub HChessBoard1_PieceMoved()
  650. 'On Error Resume Next
  651.  If Not HChessBoard1.CanIPlay Then
  652.  If Connected Then
  653.   'MsgBox "j'ai bouger :" & HChessBoard1.MoveString & "    :   " & HChessBoard1.CanIPlay
  654.   Dim strtemp, code, p1, p2, p3, p4
  655.   p1 = Val(InStr(1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  656.   p2 = Val(InStr(p1 + 1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  657.   p3 = Val(InStr(p2 + 1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  658.   p4 = Val(InStr(p3 + 1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  659.   Dim val1, val2, val3, val4
  660.   val1 = Val(Mid(HChessBoard1.MoveString, 15, p1 - 15)): val2 = Val(Mid(HChessBoard1.MoveString, p1 + 1, p2 - 15)): val3 = Val(Mid(HChessBoard1.MoveString, p2 + 1, p3 - 15)): val4 = Val(Mid(HChessBoard1.MoveString, p3 + 1, Len(HChessBoard1.MoveString) - 2 - (p2))) 'lit la position du move
  661.   strtemp = Str(val1) & Chr(val2 + 65) & " To " & Str(val3) & Chr(val4 + 65)
  662.   SockClient.SendData HChessBoard1.MoveString
  663.   DoEvents
  664.   'frmInfoG.List1.List(frmInfoG.List1.ListCount - 1) = "I: " & nbcoupmoi & " - " & NickName & " -T- : " & hrs & ":" & mins & ":" & secs & " -M- : " & strtemp
  665.   nbcoup = nbcoup + 1
  666.   hrs = "": mins = "": secs = ""
  667.   hr = 0: min = 0: sec = 0
  668.   'frmInfoG.List1.AddItem "I: " & (nbcoup - nbcoupmoi) & " - " & nomoposant & " -T- : " & hrs & ":" & mins & ":" & secs & " -M- : " & strtemp
  669.   'frmInfoG.List1.ListIndex = frmInfoG.List1.ListCount - 1
  670.   'frmInfoG.Label1.Caption = "Wait Your Turn"
  671.   waitforplayer = True
  672.   End If
  673.  Else
  674.   waitforplayer = False
  675.  End If
  676. End Sub
  677. Private Sub OpenFile()
  678.     Dim sFile As String
  679.     With dlgCommonDialog
  680.         'To Do
  681.         'set the flags and attributes of the
  682.         'common dialog control
  683.         .Filter = "All Files (*.*)|*.*"
  684.         .ShowOpen
  685.         If Len(.filename) = 0 Then
  686.             Exit Sub
  687.         End If
  688.         sFile = .filename
  689.     End With
  690.     'To Do
  691.     'process the opened file
  692. End Sub
  693. Private Sub Image1_Click(Index As Integer)
  694. Select Case Index
  695. Case 0: NewGame
  696. Case 1: HChessBoard1.Sound = Not HChessBoard1.Sound 'son
  697. Case 2: HChessBoard1.Music = Not HChessBoard1.Music 'music
  698. Case 3: MsgBox "This Option is not part of the Demo" 'frmInfoG.Visible = Not frmInfoG.Visible 'info
  699. Case 4: frmchat1.Visible = Not frmchat1.Visible 'chat
  700. Case 5: frmAbout.Show 1
  701. End Select
  702. End Sub
  703. Private Sub NewGame()
  704. Dim rep
  705. If PartiEnCour Then
  706.  rep = MsgBox("You Have a Game Currently on going do you still want to continue ?", vbYesNoCancel, "New Game")
  707.  If rep = vbYes Then
  708.      frmnewgame.Show 1
  709.  End If
  710. frmnewgame.Show 1
  711. End If
  712. End Sub
  713. Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  714. If Index <> HoldIndex Then
  715. OPTSelected = True
  716.  If HoldIndex = -1 Then HoldIndex = 0
  717.  Image1(HoldIndex).Picture = PictureClip1.GraphicCell(HoldIndex)
  718.  Image1(Index).Picture = PictureClip1.GraphicCell(Index + 6)
  719. End If
  720. HoldIndex = Index
  721. End Sub
  722. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  723. If OPTSelected Then Image1(HoldIndex).Picture = PictureClip1.GraphicCell(HoldIndex): OPTSelected = False: HoldIndex = -1
  724. End Sub
  725.